home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / fpc / sources.fpc / comp.sources.unix_1479_000001.msg next >
Text File  |  1993-08-09  |  53KB  |  2,174 lines
  1. Path: iam!chx400!cernvax!mcsun!uunet!bbn.com!rsalz
  2. From: rsalz@uunet.uu.net (Rich Salz)
  3. Newsgroups: comp.sources.unix
  4. Subject: v20i051:  Portable compiler of the FP language, Part02/06
  5. Message-ID: <2059@papaya.bbn.com>
  6. Date: 24 Oct 89 16:04:58 GMT
  7. Lines: 2164
  8. Approved: rsalz@uunet.UU.NET
  9.  
  10. Submitted-by: Edoardo Biagioni <biagioni@cs.unc.edu>
  11. Posting-number: Volume 20, Issue 51
  12. Archive-name: fpc/part02
  13.  
  14.  
  15. #    This is a shell archive.
  16. #    Remove everything above and including the cut line.
  17. #    Then run the rest of the file through sh.
  18. -----cut here-----cut here-----cut here-----cut here-----
  19. #!/bin/sh
  20. # shar:    Shell Archiver
  21. #    Run the following text with /bin/sh to create:
  22. #    fp.c.part1
  23. #    lex.yy.c
  24. echo shar: extracting fp.c.part1 '(32154 characters)'
  25. sed 's/^XX//' << \SHAR_EOF > fp.c.part1
  26. XX#include <stdio.h>
  27. XX#include <strings.h>
  28. XX#include <ctype.h>
  29. XX#include "fp.h"
  30. XX
  31. XXextern char * malloc ();
  32. XXextern char * sprintf ();
  33. XXextern exit ();
  34. XX/* for me, this should be void exit, but the man (3) page doesn't
  35. XX * think so. Some implementations have void exit, some don't, so
  36. XX * either way there is no way to tell lint to shut up about it.
  37. XX * Just ignore it if it comes up */
  38. XX
  39. XXstruct fp_object nilobj = {NILOBJ};
  40. XXstruct fp_object tobj = {TRUEOBJ};
  41. XXstruct fp_object fobj = {FALSEOBJ};
  42. XX
  43. XXstruct stackframe * stack = 0;
  44. XX
  45. XXint fpargc;
  46. XXchar ** fpargv;
  47. XX
  48. XXfp_data staticstore = 0; /* a vector of all the things that
  49. XX             * are allocated statically, so we can
  50. XX             * return them at the end. */
  51. XX
  52. XX/*
  53. XX#define NORETURN    1
  54. XX */
  55. XX/*
  56. XX#ifdef DEBUG
  57. XX#define TSTRET    /* used to test reference counting * /
  58. XX#define CHECKREF    /* used to print reference count, pointer values * /
  59. XX#endif
  60. XX */
  61. XX#ifdef NOCHECK
  62. XX#define NCOUNTVEC
  63. XX/* nocheck is the fast option, so if we have it we certainly don't want
  64. XX   to count vectors */
  65. XX#endif
  66. XX
  67. XX#ifdef NCOUNTVEC
  68. XX#ifdef TSTRET
  69. XX#undef NCOUNTVEC
  70. XX#endif
  71. XX#endif
  72. XX
  73. XX#define nonvector(x)    ((x->fp_type != NILOBJ) && \
  74. XX             (x->fp_type != VECTOR))
  75. XX#define nonboolean(x)    ((x->fp_type != TRUEOBJ) && \
  76. XX             (x->fp_type != FALSEOBJ))
  77. XX
  78. XX#ifndef NOCHECK
  79. XXvoid checkpair (data, fname)
  80. XXfp_data data;
  81. XXchar * fname;
  82. XX{
  83. XX  void parmbot ();
  84. XX
  85. XX  if (data->fp_type != VECTOR)
  86. XX    parmbot (fname, "input is not a vector", data);
  87. XX  if ((data->fp_header.fp_next == 0) ||
  88. XX      (data->fp_header.fp_next->fp_header.fp_next != 0))
  89. XX    parmbot (fname, "input is not a 2-element vector", data);
  90. XX}
  91. XX#else
  92. XX#define checkpair(data, fname)    /* no-op, don't waste code and time */
  93. XX#endif
  94. XX
  95. XXint depthcount = 0;
  96. XX
  97. XXvoid indent (n, out)
  98. XXint n;
  99. XXFILE * out;
  100. XX{
  101. XX  register int icount;
  102. XX
  103. XX  for (icount = 8; icount <= n; icount += 8)
  104. XX    (void) putc ('\t', out);
  105. XX  for (icount -= 8; icount < n; icount++)
  106. XX    (void) putc (' ', out);
  107. XX}
  108. XX
  109. XXint numprsize (n)
  110. XXlong n;
  111. XX{
  112. XX  int res;
  113. XX
  114. XX  for (res = 1; n > 9; res++)
  115. XX    n /= 10;
  116. XX  return (res);
  117. XX}
  118. XX
  119. XXint floatprsize (n)
  120. XXfloat n;
  121. XX{
  122. XX  char str [100];
  123. XX
  124. XX  (void) sprintf (str, "%f", n);
  125. XX  return (strlen (str));
  126. XX}
  127. XX
  128. XXint isstring (data)
  129. XXfp_data data;
  130. XX{
  131. XX  if (data->fp_type != VECTOR)
  132. XX    return (0);
  133. XX  while (data != 0)
  134. XX    if (data->fp_entry->fp_type != CHARCONST)
  135. XX      return (0);
  136. XX    else
  137. XX      data = data->fp_header.fp_next;
  138. XX  return (1);
  139. XX}
  140. XX
  141. XXint printlen (data)
  142. XXfp_data data;
  143. XX{
  144. XX  register fp_data ptr;
  145. XX  register int str;
  146. XX  register int result;
  147. XX#ifndef NOCHECK
  148. XX  void genbottom ();
  149. XX#endif
  150. XX
  151. XX  switch (data->fp_type)
  152. XX  {
  153. XX    case NILOBJ:
  154. XX      return (2);        /* <> */
  155. XX    case TRUEOBJ:
  156. XX      return (1);        /* T */
  157. XX    case FALSEOBJ:
  158. XX      return (1);        /* F */
  159. XX    case INTCONST:
  160. XX      return (numprsize (data->fp_header.fp_int));
  161. XX    case ATOMCONST:
  162. XX      return (strlen (data->fp_header.fp_atom));
  163. XX    case FLOATCONST:
  164. XX      return (floatprsize (data->fp_header.fp_float));
  165. XX    case CHARCONST:
  166. XX      return (2);
  167. XX    case VECTOR:
  168. XX      str = isstring (data);
  169. XX      if (str)
  170. XX    result = 2;    /* for the "" */
  171. XX      else
  172. XX    result = 1;
  173. XX/* 2 for the brackets, -1 since blank not placed before first item */
  174. XX      ptr = data;
  175. XX      while (ptr != 0)
  176. XX      {
  177. XX    if (str)
  178. XX      result += 2;
  179. XX    else
  180. XX      result += 2 + printlen (ptr->fp_entry);
  181. XX        /* 1 for the comma, 1 for the blank between elements */
  182. XX    ptr = ptr->fp_header.fp_next;
  183. XX      }
  184. XX      return (result);
  185. XX#ifndef NOCHECK
  186. XX    default:
  187. XX      genbottom ("print: unknown object type", data);
  188. XX      return (0);
  189. XX#endif
  190. XX  }
  191. XX}
  192. XX
  193. XXvoid printfpdata (out, data, ind)
  194. XXFILE * out;
  195. XXfp_data data;
  196. XXint ind;
  197. XX{
  198. XX  int chars, str;
  199. XX  char c;
  200. XX  fp_data track;
  201. XX#ifndef NOCHECK
  202. XX  void genbottom ();
  203. XX#endif
  204. XX
  205. XX#ifndef NOCHECK
  206. XX  if (data == 0)        /* invalid argument, abort */
  207. XX    genbottom ("print: null pointer passed to printfpdata", fp_nil);
  208. XX#endif
  209. XX  switch (data->fp_type)
  210. XX  {
  211. XX    case NILOBJ:
  212. XX      (void) fprintf (out, "<>");
  213. XX      break;
  214. XX    case TRUEOBJ:
  215. XX      (void) putc ('T', out);
  216. XX      break;
  217. XX    case FALSEOBJ:
  218. XX      (void) putc ('F', out);
  219. XX      break;
  220. XX    case INTCONST:
  221. XX      (void) fprintf (out, "%d", data->fp_header.fp_int);
  222. XX      break;
  223. XX    case ATOMCONST:
  224. XX      (void) fprintf (out, "%s", data->fp_header.fp_atom);
  225. XX      break;
  226. XX    case CHARCONST:
  227. XX      c = data->fp_header.fp_char;
  228. XX      if ((c > '~') || (c < ' '))
  229. XX    (void) fprintf (out, "'%3o", c);
  230. XX      else
  231. XX    (void) fprintf (out, "'%c", c);
  232. XX      break;
  233. XX    case FLOATCONST:
  234. XX      (void) fprintf (out, "%f", data->fp_header.fp_float);
  235. XX      break;
  236. XX    case VECTOR:
  237. XX      str = isstring (data);
  238. XX      if (str)
  239. XX    (void) putc ('"', out);
  240. XX      else
  241. XX      {
  242. XX    chars = printlen (data);
  243. XX    (void) putc ('<', out);
  244. XX      }
  245. XX      track = data;
  246. XX      while (track != 0)
  247. XX      {
  248. XX    if (str)
  249. XX      (void) putc (track->fp_entry->fp_header.fp_char, out);
  250. XX    else
  251. XX      printfpdata (out, track->fp_entry, ind + 1);
  252. XX    track = track->fp_header.fp_next;
  253. XX    if ((! str) && (track != 0))
  254. XX    {
  255. XX      putc (',', out);
  256. XX      if (chars > (80 - ind))    /* put on separate lines, indent */
  257. XX      {
  258. XX        (void) putc ('\n', out);
  259. XX        indent (ind + 1, out);
  260. XX      }
  261. XX      else
  262. XX        (void) putc (' ', out);
  263. XX    }
  264. XX      }
  265. XX      if (str)
  266. XX    (void) putc ('"', out);
  267. XX      else
  268. XX    (void) putc ('>', out);
  269. XX      break;
  270. XX#ifndef NOCHECK
  271. XX    default:
  272. XX      genbottom ("print: unknown object type", data);
  273. XX#endif
  274. XX  }
  275. XX#ifdef CHECKREF
  276. XX  (void) fprintf (out, ".%d/%d", data->fp_ref, data);
  277. XX#endif
  278. XX}
  279. XX
  280. XXlong unsigned currsize = 0;    /* keep stats about allocation */
  281. XXlong unsigned maxsize = 0;    /* keep stats about allocation */
  282. XX
  283. XXfp_data freelist = 0;        /* pointer to list of free cells */
  284. XX
  285. XXvoid makefree ()
  286. XX{
  287. XX  register fp_data cells;
  288. XX#define BLOCKSIZE 512
  289. XX
  290. XX  cells = (fp_data) malloc ((unsigned) BLOCKSIZE * VECTSIZE);
  291. XX#ifndef NOCHECK
  292. XX  if (cells == 0)
  293. XX    genbottom ("memory allocator: out of space", fp_nil);
  294. XX#endif
  295. XX  for (freelist = cells; (cells - freelist) < BLOCKSIZE; cells++)
  296. XX    cells->fp_entry = cells + 1;
  297. XX  cells = freelist + BLOCKSIZE - 1;
  298. XX  cells->fp_entry = 0;
  299. XX}
  300. XX
  301. XX#ifndef NCOUNTVEC
  302. XXint nalloc = 0;
  303. XX#endif
  304. XX
  305. XXfp_data newconst (type)
  306. XXint type;
  307. XX{
  308. XX  register fp_data new;
  309. XX
  310. XX#ifdef TSTRET
  311. XX  (void) fprintf (stderr, "entering newconst\n");
  312. XX#endif
  313. XX  if (freelist == 0)
  314. XX    makefree ();
  315. XX  new = freelist;
  316. XX  freelist = new->fp_entry;
  317. XX  new->fp_type = type;
  318. XX#ifndef NCOUNTVEC
  319. XX  currsize += CONSTSIZE;
  320. XX  if (currsize > maxsize)
  321. XX    maxsize = currsize;
  322. XX#endif
  323. XX#ifdef TSTRET
  324. XX  (void) fprintf (stderr, "allocated %d bytes, type is %d",
  325. XX          CONSTSIZE, new->fp_type);
  326. XX  (void) fprintf (stderr, ", max is %d, now exiting newconst\n", maxsize);
  327. XX#endif
  328. XX  return (new);
  329. XX}
  330. XX
  331. XXfp_data newcell ()
  332. XX{
  333. XX  register fp_data new;
  334. XX
  335. XX#ifdef TSTRET
  336. XX  (void) fprintf (stderr, "entering newcell, size is %d\n", size);
  337. XX#endif
  338. XX  if (freelist == 0)
  339. XX    makefree ();
  340. XX  new = freelist;
  341. XX  freelist = new->fp_entry;
  342. XX  new->fp_type = VECTOR;        /* init type, ref count */
  343. XX  new->fp_ref = 1;
  344. XX  new->fp_header.fp_next = 0;
  345. XX#ifndef NCOUNTVEC
  346. XX  nalloc++;
  347. XX  currsize += VECTSIZE;
  348. XX  if (currsize > maxsize)
  349. XX    maxsize = currsize;
  350. XX#endif
  351. XX#ifdef TSTRET
  352. XX  (void) fprintf (stderr, "%d vectors allocated so far\n", nalloc);
  353. XX  (void) fprintf (stderr, "allocated %d bytes, type is %d", VECTSIZE, VECTOR);
  354. XX  (void) fprintf (stderr, ", max is %d, now exiting newcell\n", maxsize);
  355. XX#endif
  356. XX  return (new);
  357. XX}
  358. XX
  359. XXfp_data newpair ()
  360. XX{
  361. XX  register fp_data head, tail;
  362. XX
  363. XX#ifdef TSTRET
  364. XX  (void) fprintf (stderr, "entering newpair, size is %d\n", size);
  365. XX#endif
  366. XX  if (freelist == 0)
  367. XX    makefree ();
  368. XX  head = freelist;
  369. XX  freelist = head->fp_entry;
  370. XX  if (freelist == 0)
  371. XX    makefree ();
  372. XX  tail = freelist;
  373. XX  freelist = tail->fp_entry;
  374. XX  head->fp_type = VECTOR;        /* init type, ref count */
  375. XX  head->fp_ref = 1;
  376. XX  head->fp_header.fp_next = tail;
  377. XX  tail->fp_type = VECTOR;
  378. XX  tail->fp_ref = 1;
  379. XX  tail->fp_header.fp_next = 0;
  380. XX#ifndef NCOUNTVEC
  381. XX  nalloc += 2;
  382. XX  currsize += (VECTSIZE + VECTSIZE);
  383. XX  if (currsize > maxsize)
  384. XX    maxsize = currsize;
  385. XX#endif
  386. XX#ifdef TSTRET
  387. XX  (void) fprintf (stderr, "%d vectors allocated so far\n", nalloc);
  388. XX  (void) fprintf (stderr, "allocated %d bytes, type is %d",
  389. XX          2 * VECTSIZE, VECTOR);
  390. XX  (void) fprintf (stderr, ", max is %d, now exiting newpair\n", maxsize);
  391. XX#endif
  392. XX  return (head);
  393. XX}
  394. XX
  395. XX/* the following is less efficient than newconst, newcell or newpair,
  396. XX   so should only be used with vectors of length > 2 or of variable
  397. XX   length */
  398. XXfp_data newvect (size)
  399. XXlong size;
  400. XX{
  401. XX  register fp_data new, old;
  402. XX#ifdef TSTRET
  403. XX  register int space;
  404. XX#endif
  405. XX
  406. XX#ifdef TSTRET
  407. XX  (void) fprintf (stderr, "entering newvect, size is %d\n", size);
  408. XX  space = size * VECTSIZE;
  409. XX#endif
  410. XX#ifndef NCOUNTVEC
  411. XX  currsize += size * VECTSIZE;
  412. XX  nalloc += size;
  413. XX  if (currsize > maxsize)
  414. XX    maxsize = currsize;
  415. XX#endif
  416. XX/* build the vector back-to-front */
  417. XX  old = (fp_data) 0;
  418. XX  while (size-- > 0)
  419. XX  {
  420. XX    if (freelist == 0) makefree ();
  421. XX    new = freelist;
  422. XX    freelist = freelist->fp_entry;
  423. XX    new->fp_type = VECTOR;        /* init type, ref count */
  424. XX    new->fp_ref = 1;
  425. XX    new->fp_header.fp_next = old;
  426. XX    old = new;
  427. XX  }
  428. XX#ifdef TSTRET
  429. XX  (void) fprintf (stderr, "%d vectors allocated so far\n", nalloc);
  430. XX  (void) fprintf (stderr, "allocated %d bytes, type is %d",
  431. XX          space, new->fp_type);
  432. XX  (void) fprintf (stderr, ", max is %d, now exiting newvect\n", maxsize);
  433. XX#endif
  434. XX  return (new);
  435. XX}
  436. XX
  437. XX#ifndef NCOUNTVEC
  438. XXint dalloc = 0;
  439. XX#endif
  440. XX
  441. XX/* returnvect should only be called via dec_ref, which checks for reference
  442. XX   count == 0 and type == vector */
  443. XXvoid returnvect (data)
  444. XXfp_data data;
  445. XX{
  446. XX  register fp_data old;
  447. XX
  448. XX#ifdef TSTRET
  449. XX  (void) fprintf (stderr, "entering returnvect, input is ");
  450. XX  printfpdata (stderr, data, 0);
  451. XX  (void) fprintf (stderr, "\nref count is %d\n", data->fp_ref);
  452. XX#endif
  453. XX  while ((data != 0) && (data->fp_ref == 0))
  454. XX  {
  455. XX#ifdef TSTRET
  456. XX    if (data->fp_ref < 0)
  457. XX    {
  458. XX      (void) fprintf (stderr,
  459. XX              "reference counting error, negative count found\n");
  460. XX      (void) fprintf (stderr, "data is ");
  461. XX      printfpdata (stderr, data, 0);
  462. XX      (void) fprintf (stderr, "\nreference count is %d\n", data->fp_ref);
  463. XX      (void) exit (1);
  464. XX    }
  465. XX#endif
  466. XX#ifndef NCOUNTVEC
  467. XX    currsize -= VECTSIZE;
  468. XX    dalloc++;
  469. XX#endif
  470. XX    dec_ref (data->fp_entry);    /* return element */
  471. XX    old = data;
  472. XX    data = data->fp_header.fp_next;
  473. XX    if (data != 0)        /* return tail, if it has other ref */
  474. XX      data->fp_ref--;
  475. XX#ifndef NORETURN
  476. XX    old->fp_entry = freelist;    /* return self */
  477. XX    freelist = old;
  478. XX#endif
  479. XX  }
  480. XX#ifdef TSTRET
  481. XX  (void) fprintf (stderr, "%d vectors deallocated\nexiting returnvect",
  482. XX          dalloc);
  483. XX#endif
  484. XX}
  485. XX
  486. XXvoid checkstorage ()
  487. XX{
  488. XX#ifndef NCOUNTVEC
  489. XX  if (staticstore != 0)
  490. XX    dec_ref (staticstore);
  491. XX  if (nalloc != dalloc)
  492. XX  {
  493. XX    fprintf (stderr, "WARNING: %d cells allocated, %d deallocated\n",
  494. XX         nalloc, dalloc);
  495. XX    fprintf (stderr, "(the two numbers should be the same)\n");
  496. XX    fprintf (stderr, "This is an implementation error. The above\n");
  497. XX    fprintf (stderr, "results may be incorrect.\n");
  498. XX  }
  499. XX#endif
  500. XX}
  501. XX
  502. XXvoid printstorage ()
  503. XX{
  504. XX  checkstorage ();
  505. XX#ifndef NCOUNTVEC
  506. XX  (void) fprintf (stdout,
  507. XX              "%d cells allocated, %d cells deallocated\n", nalloc, dalloc);
  508. XX  (void) fprintf (stdout,
  509. XX              "maximum space needed was %d bytes\n", maxsize);
  510. XX#endif
  511. XX}
  512. XX
  513. XXvoid putfpdata (data)
  514. XXfp_data data;
  515. XX{
  516. XX#ifdef DEBUG
  517. XX  (void) fprintf (stderr, "entering putfpdata\n");
  518. XX#endif
  519. XX  printfpdata (stdout, data, 0);
  520. XX  (void) putc ('\n', stdout);
  521. XX#ifdef DEBUG
  522. XX  (void) fprintf (stderr, "exiting putfpdata\n");
  523. XX#endif
  524. XX}
  525. XX
  526. XXvoid putfpstring (data, out)
  527. XXfp_data data;
  528. XXFILE * out;
  529. XX{
  530. XX#ifndef NOCHECK
  531. XX  if ((data->fp_type != NILOBJ) && ! isstring (data))
  532. XX    genbottom ("print string: input was not a string", data);
  533. XX#endif
  534. XX  if (data->fp_type != NILOBJ)
  535. XX    while (data != 0)
  536. XX    {
  537. XX      (void) putc (data->fp_entry->fp_header.fp_char, out);
  538. XX      data = data->fp_header.fp_next;
  539. XX    }
  540. XX}
  541. XX
  542. XXvoid putfpstrings (data)
  543. XXfp_data data;
  544. XX/* if the argument is a string it outputs it using putfpstring;
  545. XX * otherwise it must be a vector of pairs <filename string>, the
  546. XX * strings become the contents of the named files
  547. XX */
  548. XX{
  549. XX  extern FILE * fopen ();
  550. XX  extern int fclose ();
  551. XX  static void toCstring ();
  552. XX  register FILE * out;
  553. XX  register fp_data fname;
  554. XX  register fp_data string;
  555. XX  register fp_data entry;
  556. XX  register int closeres;
  557. XX  char filename [FNAMELEN];
  558. XX
  559. XX  if ((data->fp_type == NILOBJ) || isstring (data))
  560. XX    putfpstring (data, stdout);
  561. XX  else
  562. XX    while (data != 0)
  563. XX    {
  564. XX      entry = data->fp_entry;
  565. XX      data = data->fp_header.fp_next;
  566. XX#ifndef NOCHECK
  567. XX      checkpair (entry, "output routine");
  568. XX#endif
  569. XX      fname = entry->fp_entry;
  570. XX      string = entry->fp_header.fp_next->fp_entry;
  571. XX#ifndef NOCHECK
  572. XX      if (! isstring (fname))
  573. XX    genbottom ("print: file name is not a string", entry);
  574. XX/* string-ness of the string is checked in putfpstring */
  575. XX#endif
  576. XX      toCstring (fname, filename);
  577. XX      out = fopen (filename, "w");
  578. XX#ifndef NOCHECK
  579. XX      if (out == 0)
  580. XX    genbottom ("print: unable to open the output file", fname);
  581. XX#endif
  582. XX      putfpstring (string, out);
  583. XX      closeres = fclose (out);
  584. XX#ifndef NOCHECK
  585. XX      if (closeres == EOF)
  586. XX    genbottom ("print: unable to close the output file", fname);
  587. XX#endif
  588. XX    }
  589. XX}
  590. XX
  591. XXfp_data readfpdata (in, input_char, dryrun)
  592. XXFILE * in;
  593. XXchar * input_char;
  594. XXint dryrun;    /* check file (1), or actually input it (0)? */
  595. XX        /* if it's a dry run, returns fp_true if correct, */
  596. XX        /* fp_false if the file is unreadable. */
  597. XX{
  598. XX  char string [128];
  599. XX  fp_data res, next, last, numconst;
  600. XX  unsigned int pos = 0;
  601. XX  long num;
  602. XX  float real;
  603. XX  int isneg = 0;
  604. XX  int negexp = 0;
  605. XX  void genbottom ();
  606. XX
  607. XX  while (isspace (*input_char))
  608. XX    *input_char = getc (in);
  609. XX  if (*input_char == '<')    /* opening vector */
  610. XX  {
  611. XX    *input_char = getc (in);
  612. XX    while (isspace (*input_char))
  613. XX      *input_char = getc (in);
  614. XX    last = 0;
  615. XX    if (dryrun)
  616. XX      res = fp_true;
  617. XX    else
  618. XX      res = fp_nil;
  619. XX    while (*input_char != '>')
  620. XX    {
  621. XX      if (dryrun)
  622. XX      {
  623. XX        if (readfpdata (in, input_char, 1) ->fp_type != TRUEOBJ)
  624. XX      return (fp_false);
  625. XX      }
  626. XX      else
  627. XX      {
  628. XX    next = newcell ();
  629. XX    next->fp_entry = readfpdata (in, input_char, 0);
  630. XX    if (last == 0)
  631. XX      res = next;
  632. XX    else
  633. XX      last->fp_header.fp_next = next;
  634. XX    last = next;
  635. XX      }
  636. XX      while (isspace (*input_char))
  637. XX    *input_char = getc (in);
  638. XX      if ((*input_char != ',') && (*input_char != '>'))
  639. XX    if (dryrun)
  640. XX      return (fp_false);
  641. XX    else
  642. XX      genbottom ("read: comma or > expected after vector element", res);
  643. XX      if (*input_char == ',')
  644. XX        *input_char = getc (in);
  645. XX      while (isspace (*input_char))
  646. XX    *input_char = getc (in);
  647. XX    }
  648. XX    *input_char = getc (in);
  649. XX  }    /* end if vector */
  650. XX  else if (((*input_char >= '0') && (*input_char <= '9')) ||
  651. XX       (*input_char == '-') || (*input_char == '+') ||
  652. XX       (*input_char == '.'))    /* number */
  653. XX  {
  654. XX    isneg = *input_char == '-';
  655. XX    if (isneg || (*input_char == '+'))
  656. XX    {
  657. XX      *input_char = getc (in);
  658. XX      while (isspace (*input_char))
  659. XX    *input_char = getc (in);
  660. XX    }
  661. XX    num = 0;
  662. XX    while ((*input_char >= '0') && (*input_char <= '9'))
  663. XX    {
  664. XX      num = (num * 10) + (*input_char - '0');
  665. XX      *input_char = getc (in);
  666. XX    }
  667. XX    if ((*input_char != '.') && (*input_char != 'e') && (*input_char != 'E'))
  668. XX    {        /* means we have finished reading an integer */
  669. XX      if (dryrun)
  670. XX    return (fp_true);
  671. XX      res = newconst (INTCONST);
  672. XX      res->fp_header.fp_int = (isneg) ? (-num) : num;
  673. XX    }
  674. XX    else    /* floating point number */
  675. XX    {
  676. XX      real = num;
  677. XX      if (*input_char == '.')    /* reading the fractional part */
  678. XX      {
  679. XX    num = 10;        /* num is now the divisor */
  680. XX    *input_char = getc (in);
  681. XX    while ((*input_char >= '0') && (*input_char <= '9'))
  682. XX    {
  683. XX      real += ((float) (*input_char - '0')) / (float) (num);
  684. XX      num *= 10;
  685. XX      *input_char = getc (in);
  686. XX    }
  687. XX      }
  688. XX      if ((*input_char == 'e') || (*input_char == 'E'))
  689. XX      {        /* time to read the exponent */
  690. XX    *input_char = getc (in);
  691. XX    negexp = *input_char == '-';
  692. XX    if (negexp || (*input_char == '+'))
  693. XX    {
  694. XX      *input_char = getc (in);
  695. XX      while (isspace (*input_char))
  696. XX        *input_char = getc (in);
  697. XX    }
  698. XX    num = 0;
  699. XX    while ((*input_char >= '0') && (*input_char <= '9'))
  700. XX    {
  701. XX      num = (num * 10) + (*input_char - '0');
  702. XX      *input_char = getc (in);
  703. XX    }
  704. XX    while (num-- > 0)
  705. XX      if (negexp)
  706. XX        real /= 10;
  707. XX      else
  708. XX        real *= 10;
  709. XX      }
  710. XX      if (dryrun)
  711. XX    return (fp_true);
  712. XX      res = newconst (FLOATCONST);
  713. XX      res->fp_header.fp_float = (isneg) ? (-real) : real;
  714. XX    }
  715. XX  }    /* end if number */
  716. XX  else if (*input_char == '\'')        /* single char */
  717. XX  {
  718. XX    *input_char = getc (in);
  719. XX    if (*input_char == '\\')
  720. XX      *input_char = getc (in);
  721. XX    if (! dryrun)
  722. XX    {
  723. XX      res = newconst (CHARCONST);
  724. XX      res->fp_header.fp_char = *input_char;
  725. XX    }
  726. XX    *input_char = getc (in);
  727. XX  }    /* end if char */
  728. XX  else if (*input_char == '"')        /* string, i.e., vector of chars */
  729. XX  {
  730. XX    last = 0;
  731. XX    if (! dryrun)
  732. XX      res = fp_nil;
  733. XX    while (1)
  734. XX    {
  735. XX      *input_char = getc (in);
  736. XX      if (*input_char == '\\')
  737. XX    *input_char = getc (in);
  738. XX      else if (*input_char == '"')
  739. XX    break;
  740. XX      if (! dryrun)
  741. XX      {
  742. XX    numconst = newconst (CHARCONST);
  743. XX    numconst->fp_header.fp_char = *input_char;
  744. XX    next = newcell ();
  745. XX    next->fp_entry = numconst;
  746. XX    if (last == 0)
  747. XX      res = next;
  748. XX    else
  749. XX      last->fp_header.fp_next = next;
  750. XX    last = next;
  751. XX      }
  752. XX    }
  753. XX    *input_char = getc (in);
  754. XX  }    /* end if string */
  755. XX  else if (isalpha (*input_char))        /* symbol */
  756. XX  {
  757. XX    while (isalnum (*input_char) || (*input_char == '.'))
  758. XX    {
  759. XX      string [pos++] = *input_char;
  760. XX      *input_char = getc (in);
  761. XX    }
  762. XX    string [pos] = '\0';
  763. XX    if (dryrun)
  764. XX      return (fp_true);
  765. XX    if ((pos == 1) && (string [0] == 'T'))
  766. XX      res = fp_true;
  767. XX    else if ((pos == 1) && (string [0] == 'F'))
  768. XX      res = fp_false;
  769. XX    else
  770. XX    {
  771. XX      res = newconst (ATOMCONST);
  772. XX      res->fp_header.fp_atom = malloc (pos + 1);
  773. XX      (void) strcpy (res->fp_header.fp_atom, string);
  774. XX    }
  775. XX  }    /* end if symbol */
  776. XX  else if (((int) *input_char) == EOF)        /* end of file */
  777. XX  {
  778. XX    if (dryrun)
  779. XX      return (fp_false);
  780. XX    else
  781. XX      genbottom ("read: end of file reached before end of FFP object\n",
  782. XX         res);
  783. XX  }
  784. XX  else if (dryrun)
  785. XX    return (fp_false);
  786. XX  else
  787. XX  {
  788. XX    sprintf (string,
  789. XX         "read: unknown token type\nchar was %c (%d decimal)\n",
  790. XX         *input_char, *input_char);
  791. XX    genbottom (string, fp_nil);
  792. XX  }
  793. XX  return (res);
  794. XX}
  795. XX
  796. XXfp_data readfpstring (in)
  797. XXFILE * in;
  798. XX{
  799. XX  fp_data res = 0;
  800. XX  fp_data chase, cptr;
  801. XX  int input_char;
  802. XX
  803. XX  if ((in == 0) || ((input_char = getc (in)) == EOF))
  804. XX    res = fp_nil;
  805. XX  else
  806. XX  {
  807. XX    chase = res = newcell ();
  808. XX    cptr = newconst (CHARCONST);
  809. XX    cptr->fp_header.fp_char = input_char;
  810. XX    chase->fp_entry = cptr;
  811. XX    while ((input_char = getc (in)) != EOF)
  812. XX    {
  813. XX      chase = chase->fp_header.fp_next = newcell ();
  814. XX      cptr = newconst (CHARCONST);
  815. XX      cptr->fp_header.fp_char = input_char;
  816. XX      chase->fp_entry = cptr;
  817. XX    }
  818. XX  }
  819. XX  return (res);
  820. XX}
  821. XX
  822. XXfp_data getfpdata ()
  823. XX{
  824. XX  fp_data res;
  825. XX  char input_char;
  826. XX
  827. XX#ifdef DEBUG
  828. XX  (void) fprintf (stderr, "entering getfpdata\n");
  829. XX#endif
  830. XX  input_char = getc (stdin);
  831. XX  res = readfpdata (stdin, &input_char, 0);
  832. XX#ifdef DEBUG
  833. XX  (void) fprintf (stderr, "exiting getfpdata, result is ");
  834. XX  printfpdata (stderr, res, 0);
  835. XX  (void) putc ('\n', stderr);
  836. XX#endif
  837. XX  return (res);
  838. XX}
  839. XX
  840. XXfp_data getfpchar ()
  841. XX{
  842. XX  fp_data res;
  843. XX
  844. XX#ifdef DEBUG
  845. XX  (void) fprintf (stderr, "entering getfpchar\n");
  846. XX#endif
  847. XX  res = newconst (CHARCONST);
  848. XX  res->fp_header.fp_char = getc (stdin);
  849. XX#ifdef DEBUG
  850. XX  (void) fprintf (stderr, "exiting getfpchar, result is ");
  851. XX  printfpdata (stderr, res, 0);
  852. XX  (void) putc ('\n', stderr);
  853. XX#endif
  854. XX  return (res);
  855. XX}
  856. XX
  857. XXfp_data getfpstring ()
  858. XX{
  859. XX  fp_data res;
  860. XX
  861. XX#ifdef DEBUG
  862. XX  (void) fprintf (stderr, "entering getfpstring\n");
  863. XX#endif
  864. XX  res = readfpstring (stdin);
  865. XX#ifdef DEBUG
  866. XX  (void) fprintf (stderr, "exiting getfpstring, result is ");
  867. XX  printfpdata (stderr, res, 0);
  868. XX  (void) putc ('\n', stderr);
  869. XX#endif
  870. XX  return (res);
  871. XX}
  872. XX
  873. XX#ifndef NOCHECK
  874. XXint getonec (f)
  875. XXFILE * f;
  876. XX{
  877. XX  int ch, ch1;
  878. XX
  879. XX  ch1 = ch = getc (f);
  880. XX  while ((ch1 != '\n') && (ch1 != EOF))
  881. XX    ch1 = getc (f);
  882. XX  return (ch);
  883. XX}
  884. XX
  885. XXvoid stackdump (interfile, inter, outfile, baddata)
  886. XXFILE * interfile;
  887. XXint inter;
  888. XXFILE * outfile;
  889. XXint baddata;
  890. XX{
  891. XX  int ch;
  892. XX  int levels = 0;
  893. XX
  894. XX  while (stack != 0)
  895. XX  {
  896. XX    if ((! baddata) || (levels++ > 1))
  897. XX    {
  898. XX      (void) fprintf (outfile, "called by routine %s, with input\n",
  899. XX              stack->st_name);
  900. XX      printfpdata (outfile, stack->st_data, 0);
  901. XX    }
  902. XX    else
  903. XX      (void) fprintf (outfile,
  904. XX              "called by routine %s, with probably bad data\n",
  905. XX              stack->st_name);
  906. XX    stack = stack->st_prev;
  907. XX    (void) putc ('\n', outfile);
  908. XX    if (inter)
  909. XX    {
  910. XX      (void) fprintf (outfile, "continue stack dump?\n", stack->st_name);
  911. XX      ch = getonec (interfile);
  912. XX      if ((ch == 'n') || (ch == 'N'))
  913. XX    break;
  914. XX    }
  915. XX  }
  916. XX}
  917. XX#endif
  918. XX
  919. XX/* cannot be static because used by the main loop, sometimes */
  920. XXvoid genbottom (message, data)
  921. XXchar * message;
  922. XXfp_data data;
  923. XX{
  924. XX  int ch;
  925. XX  static int reentrant = 0;
  926. XX  FILE * core;
  927. XX
  928. XX  (void) fprintf (stderr, "error: bottom produced during execution\n");
  929. XX  (void) fprintf (stderr, "%s\n", message);
  930. XX  if (reentrant)
  931. XX    (void) fprintf (stderr, "an invalid pointer was input to the primitive\n");
  932. XX  else
  933. XX  {
  934. XX    reentrant = 1;        /* might be called by printfpdata */
  935. XX    printfpdata (stderr, data, 0);
  936. XX    (void) putc ('\n', stderr);
  937. XX    reentrant = 0;
  938. XX  }
  939. XX#ifndef NOCHECK
  940. XX  (void) fprintf (stderr, "do you wish a stack dump (y/n)?\n");
  941. XX  ch = getonec (stdin);
  942. XX  if (ch == EOF)
  943. XX  {
  944. XX    (void) fprintf (stderr, "dumping the stack to file 'core'\n");
  945. XX    core = fopen ("core", "w");
  946. XX    stackdump (stdin, 0, core, reentrant);
  947. XX    reentrant = fclose (core);
  948. XX  }
  949. XX  else if ((ch != 'n') && (ch != 'N'))
  950. XX  {
  951. XX    (void) fprintf (stderr, "interactive stack dump (y/n)?\n");
  952. XX    ch = getonec (stdin);
  953. XX    (void) fprintf (stderr, "dumping the relevant portions of the stack:\n");
  954. XX    stackdump (stdin, (ch == 'y') || (ch == 'Y'), stderr, reentrant);
  955. XX  }
  956. XX#endif
  957. XX  (void) fprintf (stderr, "aborting...\n");
  958. XX  (void) exit (1);
  959. XX}
  960. XX
  961. XXfp_data checkpoint (data)
  962. XXfp_data data;
  963. XX/* behaves the same as id, but outputs its data */
  964. XX{
  965. XX  static int asked = 0;
  966. XX  static int keepasking = 0;
  967. XX  struct stackframe * savestack;
  968. XX  static FILE * tty;
  969. XX  int ch;
  970. XX
  971. XX#ifndef NOCHECK
  972. XX  if (! asked)
  973. XX  {
  974. XX    asked = 1;
  975. XX    tty = fopen  ("/dev/tty", "r");
  976. XX    if (tty != 0)
  977. XX    {
  978. XX      (void) fprintf (stderr,
  979. XX           "do you wish to interact with the checkpoints (y/n)?\n");
  980. XX      ch = getonec (tty);
  981. XX      keepasking = ((ch == 'y') || (ch == 'Y'));
  982. XX    }
  983. XX  }
  984. XX#endif
  985. XX  (void) fprintf (stderr, "checkpoint encountered, input is\n");
  986. XX  printfpdata (stderr, data, 0);
  987. XX  (void) putc ('\n', stderr);
  988. XX#ifndef NOCHECK
  989. XX  if (keepasking)
  990. XX  {
  991. XX    (void) fprintf (stderr,
  992. XX"type y for stack dump, a to abort, space or new-line to continue\n");
  993. XX    ch = getonec (tty);
  994. XX    if ((ch == 'a') || (ch == 'A'))
  995. XX    {
  996. XX      (void) fprintf (stderr, "\naborting...\n");
  997. XX      (void) exit (1);
  998. XX    }
  999. XX    if ((ch == 'y') || (ch == 'Y'))
  1000. XX    {
  1001. XX      savestack = stack;
  1002. XX      (void) fprintf (stderr, "interactive stack dump (y/n)?\n");
  1003. XX      ch = getonec (tty);
  1004. XX      (void) fprintf (stderr, "dumping the relevant portions of the stack:\n");
  1005. XX      stackdump (tty, ((ch == 'y') || (ch == 'Y')), stderr, 0);
  1006. XX      stack = savestack;
  1007. XX    }
  1008. XX  }
  1009. XX#endif
  1010. XX  return (data);
  1011. XX}
  1012. XX
  1013. XXfp_data error (data)
  1014. XXfp_data data;
  1015. XX{
  1016. XX  genbottom ("error: ", data);
  1017. XX}
  1018. XX
  1019. XXfp_data tl (data)
  1020. XXfp_data data;
  1021. XX{
  1022. XX  register fp_data res;
  1023. XX
  1024. XX#ifdef DEBUG
  1025. XX  (void) fprintf (stderr, "entering tl, object is ");
  1026. XX  printfpdata (stderr, data, 0);
  1027. XX  (void) putc ('\n', stderr);
  1028. XX#endif
  1029. XX#ifndef NOCHECK
  1030. XX  if (data->fp_type != VECTOR)
  1031. XX    genbottom ("tl: data is not a vector", data);
  1032. XX#endif
  1033. XX  res = data->fp_header.fp_next;
  1034. XX  if (res == 0)
  1035. XX    res = & nilobj;
  1036. XX  else
  1037. XX    res->fp_ref += 1;
  1038. XX  dec_ref (data);
  1039. XX#ifdef DEBUG
  1040. XX  (void) fprintf (stderr, "exiting tl, result is ");
  1041. XX  printfpdata (stderr, res, 0);
  1042. XX  (void) putc ('\n', stderr);
  1043. XX#endif
  1044. XX  return (res);
  1045. XX}
  1046. XX
  1047. XXfp_data tlr (data)
  1048. XXfp_data data;
  1049. XX{
  1050. XX  register fp_data res, vector, prev, next;
  1051. XX
  1052. XX#ifdef DEBUG
  1053. XX  (void) fprintf (stderr, "entering tlr, object is ");
  1054. XX  printfpdata (stderr, data, 0);
  1055. XX  (void) putc ('\n', stderr);
  1056. XX#endif
  1057. XX#ifndef NOCHECK
  1058. XX  if (data->fp_type != VECTOR)
  1059. XX    genbottom ("tlr: data is not a vector", data);
  1060. XX#endif
  1061. XX  vector = data;
  1062. XX  if (vector->fp_header.fp_next == 0)
  1063. XX    res = fp_nil;
  1064. XX  else
  1065. XX  {
  1066. XX    prev = res = next = newcell ();
  1067. XX    next->fp_entry = vector->fp_entry;
  1068. XX    inc_ref (next->fp_entry);
  1069. XX    while ((vector = vector->fp_header.fp_next)->fp_header.fp_next != 0)
  1070. XX    {
  1071. XX      next = newcell ();
  1072. XX      next->fp_entry = vector->fp_entry;
  1073. XX      prev->fp_header.fp_next = next;
  1074. XX      prev = next;
  1075. XX      inc_ref (next->fp_entry);
  1076. XX    }
  1077. XX  }
  1078. XX  dec_ref (data);
  1079. XX#ifdef DEBUG
  1080. XX  (void) fprintf (stderr, "exiting tlr, result is ");
  1081. XX  printfpdata (stderr, res, 0);
  1082. XX  (void) putc ('\n', stderr);
  1083. XX#endif
  1084. XX  return (res);
  1085. XX}
  1086. XX
  1087. XXfp_data rotl (data)
  1088. XXfp_data data;
  1089. XX{
  1090. XX  register fp_data res, from, to;
  1091. XX  register long size;
  1092. XX
  1093. XX#ifdef DEBUG
  1094. XX  (void) fprintf (stderr, "entering rotl, object is ");
  1095. XX  printfpdata (stderr, data, 0);
  1096. XX  (void) putc ('\n', stderr);
  1097. XX#endif
  1098. XX#ifndef NOCHECK
  1099. XX  if (nonvector (data))
  1100. XX    genbottom ("rotl: data is not a vector or nil", data);
  1101. XX#endif
  1102. XX  res = data;
  1103. XX  if (data->fp_type != NILOBJ)
  1104. XX  {
  1105. XX    for (size = 0; res != 0; res = res->fp_header.fp_next)
  1106. XX      size++;
  1107. XX    res = newvect (size);
  1108. XX    from = data->fp_header.fp_next;
  1109. XX    to = res;
  1110. XX    while (from != 0)
  1111. XX    {
  1112. XX      to->fp_entry = from->fp_entry;
  1113. XX      inc_ref (to->fp_entry);
  1114. XX      to = to->fp_header.fp_next;
  1115. XX      from = from->fp_header.fp_next;
  1116. XX    }
  1117. XX    to->fp_entry = data->fp_entry;
  1118. XX    inc_ref (to->fp_entry);
  1119. XX    dec_ref (data);
  1120. XX  }
  1121. XX#ifdef DEBUG
  1122. XX  (void) fprintf (stderr, "exiting rotl, result is ");
  1123. XX  printfpdata (stderr, res, 0);
  1124. XX  (void) putc ('\n', stderr);
  1125. XX#endif
  1126. XX  return (res);
  1127. XX}
  1128. XX
  1129. XXfp_data rotr (data)
  1130. XXfp_data data;
  1131. XX{
  1132. XX  register fp_data res, from, to;
  1133. XX  register long size;
  1134. XX
  1135. XX#ifdef DEBUG
  1136. XX  (void) fprintf (stderr, "entering rotr, object is ");
  1137. XX  printfpdata (stderr, data, 0);
  1138. XX  (void) putc ('\n', stderr);
  1139. XX#endif
  1140. XX#ifndef NOCHECK
  1141. XX  if (nonvector (data))
  1142. XX    genbottom ("rotr: data is not a vector or nil", data);
  1143. XX#endif
  1144. XX  res = data;
  1145. XX  if (data->fp_type != NILOBJ)
  1146. XX  {
  1147. XX    for (size = 0; res != 0; res = res->fp_header.fp_next)
  1148. XX      size++;
  1149. XX    res = newvect (size);
  1150. XX    from = data;
  1151. XX    to = res->fp_header.fp_next;
  1152. XX    while (to != 0)
  1153. XX    {
  1154. XX      to->fp_entry = from->fp_entry;
  1155. XX      inc_ref (to->fp_entry);
  1156. XX      to = to->fp_header.fp_next;
  1157. XX      from = from->fp_header.fp_next;
  1158. XX    }
  1159. XX    res->fp_entry = from->fp_entry;
  1160. XX    inc_ref (res->fp_entry);
  1161. XX    dec_ref (data);
  1162. XX  }
  1163. XX#ifdef DEBUG
  1164. XX  (void) fprintf (stderr, "exiting rotr, result is ");
  1165. XX  printfpdata (stderr, res, 0);
  1166. XX  (void) putc ('\n', stderr);
  1167. XX#endif
  1168. XX  return (res);
  1169. XX}
  1170. XX
  1171. XXfp_data id (data)
  1172. XXfp_data data;
  1173. XX{
  1174. XX#ifdef DEBUG
  1175. XX  (void) fprintf (stderr, "entering id, object is ");
  1176. XX  printfpdata (stderr, data, 0);
  1177. XX  (void) putc ('\n', stderr);
  1178. XX#endif
  1179. XX#ifdef DEBUG
  1180. XX  (void) fprintf (stderr, "exiting id, result is ");
  1181. XX  printfpdata (stderr, data, 0);
  1182. XX  (void) putc ('\n', stderr);
  1183. XX#endif
  1184. XX  return (data);
  1185. XX}
  1186. XX
  1187. XXfp_data atom (data)
  1188. XXfp_data data;
  1189. XX{
  1190. XX  register fp_data res;
  1191. XX
  1192. XX#ifdef DEBUG
  1193. XX  (void) fprintf (stderr, "entering atom, object is ");
  1194. XX  printfpdata (stderr, data, 0);
  1195. XX  (void) putc ('\n', stderr);
  1196. XX#endif
  1197. XX  if (data->fp_type != VECTOR)
  1198. XX    res = (fp_true);
  1199. XX  else
  1200. XX    res = (fp_false);
  1201. XX  dec_ref (data);
  1202. XX#ifdef DEBUG
  1203. XX  (void) fprintf (stderr, "exiting atom, result is ");
  1204. XX  printfpdata (stderr, res, 0);
  1205. XX  (void) putc ('\n', stderr);
  1206. XX#endif
  1207. XX  return (res);
  1208. XX}
  1209. XX
  1210. XXfp_data reverse (data)
  1211. XXfp_data data;
  1212. XX{
  1213. XX  register fp_data res, saveres, vector;
  1214. XX
  1215. XX#ifdef DEBUG
  1216. XX  (void) fprintf (stderr, "entering reverse, object is ");
  1217. XX  printfpdata (stderr, data, 0);
  1218. XX  (void) putc ('\n', stderr);
  1219. XX#endif
  1220. XX#ifndef NOCHECK
  1221. XX  if (nonvector (data))
  1222. XX    genbottom ("reverse: data is not a vector or nil", data);
  1223. XX#endif
  1224. XX  if (data->fp_type == NILOBJ)
  1225. XX    res = data;
  1226. XX  else
  1227. XX  {
  1228. XX    vector = data;
  1229. XX    res = 0;
  1230. XX    while (vector != 0)
  1231. XX    {
  1232. XX      saveres = res;
  1233. XX      res = newcell ();
  1234. XX      res->fp_header.fp_next = saveres;
  1235. XX      res->fp_entry = vector->fp_entry;
  1236. XX      inc_ref (res->fp_entry);
  1237. XX      vector = vector->fp_header.fp_next;
  1238. XX    }
  1239. XX    dec_ref (data);
  1240. XX  }
  1241. XX#ifdef DEBUG
  1242. XX  (void) fprintf (stderr, "exiting reverse, result is ");
  1243. XX  printfpdata (stderr, res, 0);
  1244. XX  (void) putc ('\n', stderr);
  1245. XX#endif
  1246. XX  return (res);
  1247. XX}
  1248. XX
  1249. XXfp_data distl (data)
  1250. XXfp_data data;
  1251. XX{
  1252. XX  register fp_data obj, vector, res, newobjs, prev, next;
  1253. XX
  1254. XX#ifdef DEBUG
  1255. XX  (void) fprintf (stderr, "entering distl, object is ");
  1256. XX  printfpdata (stderr, data, 0);
  1257. XX  (void) putc ('\n', stderr);
  1258. XX#endif
  1259. XX#ifndef NOCHECK
  1260. XX  if (data->fp_type != VECTOR)
  1261. XX    genbottom ("distl: input is not a vector", data);
  1262. XX  if ((data->fp_header.fp_next == 0) ||
  1263. XX      (data->fp_header.fp_next->fp_header.fp_next != 0))
  1264. XX    genbottom ("distl: input is not a 2-element vector", data);
  1265. XX#endif
  1266. XX  obj = data->fp_entry;
  1267. XX  vector = data->fp_header.fp_next->fp_entry;
  1268. XX#ifndef NOCHECK
  1269. XX  if (nonvector (vector))
  1270. XX    genbottom ("distl: 2nd element is not a vector or nil", data);
  1271. XX#endif
  1272. XX  res = vector;
  1273. XX  if (vector->fp_type != NILOBJ)
  1274. XX  {
  1275. XX    res = next = newcell ();
  1276. XX    newobjs = newpair ();
  1277. XX    newobjs->fp_entry = obj;
  1278. XX    inc_ref (obj);
  1279. XX    newobjs->fp_header.fp_next->fp_entry = vector->fp_entry;
  1280. XX    inc_ref (vector->fp_entry);
  1281. XX    next->fp_entry = newobjs;
  1282. XX    while ((vector = vector->fp_header.fp_next) != 0)
  1283. XX    {
  1284. XX      prev = next;
  1285. XX      next = newcell ();
  1286. XX      newobjs = newpair ();
  1287. XX      newobjs->fp_entry = obj;
  1288. XX      inc_ref (obj);
  1289. XX      newobjs->fp_header.fp_next->fp_entry = vector->fp_entry;
  1290. XX      inc_ref (vector->fp_entry);
  1291. XX      next->fp_entry = newobjs;
  1292. XX      prev->fp_header.fp_next = next;
  1293. XX    }
  1294. XX  }
  1295. XX  dec_ref (data);
  1296. XX#ifdef DEBUG
  1297. XX  (void) fprintf (stderr, "exiting distl, result is ");
  1298. XX  printfpdata (stderr, res, 0);
  1299. XX  (void) putc ('\n', stderr);
  1300. XX#endif
  1301. XX  return (res);
  1302. XX}
  1303. XX
  1304. XXfp_data distr (data)
  1305. XXfp_data data;
  1306. XX{
  1307. XX  register fp_data obj, vector, res, newobjs, prev, next;
  1308. XX
  1309. XX#ifdef DEBUG
  1310. XX  (void) fprintf (stderr, "entering distr, object is ");
  1311. XX  printfpdata (stderr, data, 0);
  1312. XX  (void) putc ('\n', stderr);
  1313. XX#endif
  1314. XX#ifndef NOCHECK
  1315. XX  if (data->fp_type != VECTOR)
  1316. XX    genbottom ("distr: input is not a vector", data);
  1317. XX  if ((data->fp_header.fp_next == 0) ||
  1318. XX      (data->fp_header.fp_next->fp_header.fp_next != 0))
  1319. XX    genbottom ("distr: input is not a 2-element vector", data);
  1320. XX#endif
  1321. XX  vector = data->fp_entry;
  1322. XX  obj = data->fp_header.fp_next->fp_entry;
  1323. XX#ifndef NOCHECK
  1324. XX  if (nonvector (vector))
  1325. XX    genbottom ("distr: 1st element is not a vector or nil", data);
  1326. XX#endif
  1327. XX  res = vector;    /* so it's correct if vector == nil */
  1328. XX  if (vector->fp_type != NILOBJ)
  1329. XX  {
  1330. XX    res = next = newcell ();
  1331. XX    newobjs = newpair ();
  1332. XX    newobjs->fp_header.fp_next->fp_entry = obj;
  1333. XX    inc_ref (obj);
  1334. XX    newobjs->fp_entry = vector->fp_entry;
  1335. XX    inc_ref (vector->fp_entry);
  1336. XX    next->fp_entry = newobjs;
  1337. XX    while ((vector = vector->fp_header.fp_next) != 0)
  1338. XX    {
  1339. XX      prev = next;
  1340. XX      next = newcell ();
  1341. XX      newobjs = newpair ();
  1342. XX      newobjs->fp_header.fp_next->fp_entry = obj;
  1343. XX      inc_ref (obj);
  1344. XX      newobjs->fp_entry = vector->fp_entry;
  1345. XX      inc_ref (vector->fp_entry);
  1346. XX      next->fp_entry = newobjs;
  1347. XX      prev->fp_header.fp_next = next;
  1348. XX    }
  1349. XX  }
  1350. XX  dec_ref (data);
  1351. XX#ifdef DEBUG
  1352. XX  (void) fprintf (stderr, "exiting distr, result is ");
  1353. XX  printfpdata (stderr, res, 0);
  1354. XX  (void) putc ('\n', stderr);
  1355. XX#endif
  1356. XX  return (res);
  1357. XX}
  1358. XX
  1359. XXfp_data apndl (data)
  1360. XXfp_data data;
  1361. XX{
  1362. XX  register fp_data vector, el, res;
  1363. XX
  1364. XX#ifdef DEBUG
  1365. XX  (void) fprintf (stderr, "entering apndl, object is ");
  1366. XX  printfpdata (stderr, data, 0);
  1367. XX  (void) putc ('\n', stderr);
  1368. XX#endif
  1369. XX#ifndef NOCHECK
  1370. XX  if (data->fp_type != VECTOR)
  1371. XX    genbottom ("apndl: input is not a vector", data);
  1372. XX  if ((data->fp_header.fp_next == 0) ||
  1373. XX      (data->fp_header.fp_next->fp_header.fp_next != 0))
  1374. XX    genbottom ("apndl: input is not a 2-element vector", data);
  1375. XX#endif
  1376. XX  el = data->fp_entry;
  1377. XX  vector = data->fp_header.fp_next->fp_entry;
  1378. XX#ifndef NOCHECK
  1379. XX  if (nonvector (vector))
  1380. XX    genbottom ("apndl: 2nd element is not a vector or nil", data);
  1381. XX#endif
  1382. XX  if (vector->fp_type != VECTOR)        /* nil? */
  1383. XX    vector = 0;
  1384. XX  else
  1385. XX    inc_ref (vector);
  1386. XX  res = newcell ();
  1387. XX  res->fp_entry = el;
  1388. XX  inc_ref (el);
  1389. XX  res->fp_header.fp_next = vector;
  1390. XX  dec_ref (data);
  1391. XX#ifdef DEBUG
  1392. XX  (void) fprintf (stderr, "exiting apndl, result is ");
  1393. XX  printfpdata (stderr, res, 0);
  1394. XX  (void) putc ('\n', stderr);
  1395. XX#endif
  1396. XX  return (res);
  1397. XX}
  1398. SHAR_EOF
  1399. if test 32154 -ne "`wc -c fp.c.part1`"
  1400. then
  1401. echo shar: error transmitting fp.c.part1 '(should have been 32154 characters)'
  1402. fi
  1403. echo shar: extracting lex.yy.c '(12642 characters)'
  1404. sed 's/^XX//' << \SHAR_EOF > lex.yy.c
  1405. XX# include "stdio.h"
  1406. XX# define U(x) x
  1407. XX# define NLSTATE yyprevious=YYNEWLINE
  1408. XX# define BEGIN yybgin = yysvec + 1 +
  1409. XX# define INITIAL 0
  1410. XX# define YYLERR yysvec
  1411. XX# define YYSTATE (yyestate-yysvec-1)
  1412. XX# define YYOPTIM 1
  1413. XX# define YYLMAX 200
  1414. XX# define output(c) (void) putc(c,yyout)
  1415. XX# define input() (((yytchar=yysptr>yysbuf?U(*--yysptr):getc(yyin))==10?(yylineno++,yytchar):yytchar)==EOF?0:yytchar)
  1416. XX# define unput(c) {yytchar= (c);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;}
  1417. XX# define yymore() (yymorfg=1)
  1418. XX# define ECHO (void) fprintf(yyout, "%s",yytext)
  1419. XX# define REJECT { nstr = yyreject(); goto yyfussy;}
  1420. XXint yyleng; extern char yytext[];
  1421. XXint yymorfg;
  1422. XXextern char *yysptr, yysbuf[];
  1423. XXint yytchar;
  1424. XXFILE *yyin ={stdin}, *yyout ={stdout};
  1425. XXextern int yylineno;
  1426. XXstruct yysvf { 
  1427. XX    struct yywork *yystoff;
  1428. XX    struct yysvf *yyother;
  1429. XX    int *yystops;};
  1430. XXstruct yysvf *yyestate;
  1431. XXextern struct yysvf yysvec[], *yybgin;
  1432. XX# define YYNEWLINE 10
  1433. XXyylex(){
  1434. XXint nstr; extern int yyprevious;
  1435. XXwhile((nstr = yylook()) >= 0)
  1436. XXyyfussy: switch(nstr){
  1437. XXcase 0:
  1438. XXif(yywrap()) return(0); break;
  1439. XXcase 1:
  1440. XX    { return (Def); }
  1441. XXbreak;
  1442. XXcase 2:
  1443. XX    { return (Then); }
  1444. XXbreak;
  1445. XXcase 3:
  1446. XX    { return (Else); }
  1447. XXbreak;
  1448. XXcase 4:
  1449. XX    { return (Compose); }
  1450. XXbreak;
  1451. XXcase 5:
  1452. XX    { return (Alpha); }
  1453. XXbreak;
  1454. XXcase 6:
  1455. XX    { return (Tree); }
  1456. XXbreak;
  1457. XXcase 7:
  1458. XX    { return (Insert); }
  1459. XXbreak;
  1460. XXcase 8:
  1461. XX    { return (Rinsert); }
  1462. XXbreak;
  1463. XXcase 9:
  1464. XX    { return (','); }
  1465. XXbreak;
  1466. XXcase 10:
  1467. XX    { return ('['); }
  1468. XXbreak;
  1469. XXcase 11:
  1470. XX    { return (']'); }
  1471. XXbreak;
  1472. XXcase 12:
  1473. XX    { return ('('); }
  1474. XXbreak;
  1475. XXcase 13:
  1476. XX    { return (')'); }
  1477. XXbreak;
  1478. XXcase 14:
  1479. XX    { return ('<'); }
  1480. XXbreak;
  1481. XXcase 15:
  1482. XX    { return ('>'); }
  1483. XXbreak;
  1484. XXcase 16:
  1485. XX    { return ('_'); }
  1486. XXbreak;
  1487. XXcase 17:
  1488. XX    { return (Bu); }
  1489. XXbreak;
  1490. XXcase 18:
  1491. XX    { return (Bur); }
  1492. XXbreak;
  1493. XXcase 19:
  1494. XX    { return (While); }
  1495. XXbreak;
  1496. XXcase 20:
  1497. XX    { return ('+'); }
  1498. XXbreak;
  1499. XXcase 21:
  1500. XX    { return ('*'); }
  1501. XXbreak;
  1502. XXcase 22:
  1503. XX    { return (Div); }
  1504. XXbreak;
  1505. XXcase 23:
  1506. XX    { return ('='); }
  1507. XXbreak;
  1508. XXcase 24:
  1509. XX    { return (Leq); }
  1510. XXbreak;
  1511. XXcase 25:
  1512. XX    { return (Geq); }
  1513. XXbreak;
  1514. XXcase 26:
  1515. XX    { return (Noteq); }
  1516. XXbreak;
  1517. XXcase 27:
  1518. XX    { return (TrueConst); }
  1519. XXbreak;
  1520. XXcase 28:
  1521. XX    { return (FalseConst); }
  1522. XXbreak;
  1523. XXcase 29:
  1524. XX{ return (Symbol); }
  1525. XXbreak;
  1526. XXcase 30:
  1527. XX    { return (Rsel); }
  1528. XXbreak;
  1529. XXcase 31:
  1530. XX{ return (Float); }
  1531. XXbreak;
  1532. XXcase 32:
  1533. XX{ return (Float); }
  1534. XXbreak;
  1535. XXcase 33:
  1536. XX{ return (Sel); }
  1537. XXbreak;
  1538. XXcase 34:
  1539. XX    { return (Sel); }
  1540. XXbreak;
  1541. XXcase 35:
  1542. XX    { return ('-'); }
  1543. XXbreak;
  1544. XXcase 36:
  1545. XX{ return (String); }
  1546. XXbreak;
  1547. XXcase 37:
  1548. XX    { return (CharConst); }
  1549. XXbreak;
  1550. XXcase 38:
  1551. XX    { return (CharConst); }
  1552. XXbreak;
  1553. XXcase 39:
  1554. XX{ set_line (yytext); }
  1555. XXbreak;
  1556. XXcase 40:
  1557. XX    { inc_line (); }
  1558. XXbreak;
  1559. XXcase 41:
  1560. XX    { inc_line (); }
  1561. XXbreak;
  1562. XXcase 42:
  1563. XX    ;
  1564. XXbreak;
  1565. XXcase -1:
  1566. XXbreak;
  1567. XXdefault:
  1568. XX(void) fprintf(yyout,"bad switch yylook %d",nstr);
  1569. XX} return(0); }
  1570. XX/* end of yylex */
  1571. XXint yyvstop[] ={
  1572. XX0,
  1573. XX
  1574. XX42,
  1575. XX0,
  1576. XX
  1577. XX41,
  1578. XX0,
  1579. XX
  1580. XX42,
  1581. XX0,
  1582. XX
  1583. XX42,
  1584. XX0,
  1585. XX
  1586. XX42,
  1587. XX0,
  1588. XX
  1589. XX42,
  1590. XX0,
  1591. XX
  1592. XX12,
  1593. XX42,
  1594. XX0,
  1595. XX
  1596. XX13,
  1597. XX42,
  1598. XX0,
  1599. XX
  1600. XX21,
  1601. XX42,
  1602. XX0,
  1603. XX
  1604. XX20,
  1605. XX42,
  1606. XX0,
  1607. XX
  1608. XX9,
  1609. XX42,
  1610. XX0,
  1611. XX
  1612. XX35,
  1613. XX42,
  1614. XX0,
  1615. XX
  1616. XX7,
  1617. XX42,
  1618. XX0,
  1619. XX
  1620. XX34,
  1621. XX42,
  1622. XX0,
  1623. XX
  1624. XX3,
  1625. XX42,
  1626. XX0,
  1627. XX
  1628. XX14,
  1629. XX42,
  1630. XX0,
  1631. XX
  1632. XX23,
  1633. XX42,
  1634. XX0,
  1635. XX
  1636. XX15,
  1637. XX42,
  1638. XX0,
  1639. XX
  1640. XX29,
  1641. XX42,
  1642. XX0,
  1643. XX
  1644. XX29,
  1645. XX42,
  1646. XX0,
  1647. XX
  1648. XX28,
  1649. XX29,
  1650. XX42,
  1651. XX0,
  1652. XX
  1653. XX27,
  1654. XX29,
  1655. XX42,
  1656. XX0,
  1657. XX
  1658. XX10,
  1659. XX42,
  1660. XX0,
  1661. XX
  1662. XX8,
  1663. XX42,
  1664. XX0,
  1665. XX
  1666. XX11,
  1667. XX42,
  1668. XX0,
  1669. XX
  1670. XX16,
  1671. XX42,
  1672. XX0,
  1673. XX
  1674. XX29,
  1675. XX42,
  1676. XX0,
  1677. XX
  1678. XX29,
  1679. XX42,
  1680. XX0,
  1681. XX
  1682. XX29,
  1683. XX42,
  1684. XX0,
  1685. XX
  1686. XX4,
  1687. XX29,
  1688. XX42,
  1689. XX0,
  1690. XX
  1691. XX29,
  1692. XX42,
  1693. XX0,
  1694. XX
  1695. XX42,
  1696. XX0,
  1697. XX
  1698. XX26,
  1699. XX0,
  1700. XX
  1701. XX36,
  1702. XX0,
  1703. XX
  1704. XX40,
  1705. XX0,
  1706. XX
  1707. XX38,
  1708. XX0,
  1709. XX
  1710. XX38,
  1711. XX0,
  1712. XX
  1713. XX33,
  1714. XX0,
  1715. XX
  1716. XX2,
  1717. XX0,
  1718. XX
  1719. XX32,
  1720. XX0,
  1721. XX
  1722. XX34,
  1723. XX0,
  1724. XX
  1725. XX30,
  1726. XX0,
  1727. XX
  1728. XX24,
  1729. XX0,
  1730. XX
  1731. XX25,
  1732. XX0,
  1733. XX
  1734. XX29,
  1735. XX0,
  1736. XX
  1737. XX29,
  1738. XX0,
  1739. XX
  1740. XX6,
  1741. XX0,
  1742. XX
  1743. XX5,
  1744. XX29,
  1745. XX0,
  1746. XX
  1747. XX17,
  1748. XX29,
  1749. XX0,
  1750. XX
  1751. XX29,
  1752. XX0,
  1753. XX
  1754. XX29,
  1755. XX0,
  1756. XX
  1757. XX37,
  1758. XX0,
  1759. XX
  1760. XX31,
  1761. XX0,
  1762. XX
  1763. XX1,
  1764. XX29,
  1765. XX0,
  1766. XX
  1767. XX18,
  1768. XX29,
  1769. XX0,
  1770. XX
  1771. XX22,
  1772. XX29,
  1773. XX0,
  1774. XX
  1775. XX29,
  1776. XX0,
  1777. XX
  1778. XX29,
  1779. XX0,
  1780. XX
  1781. XX19,
  1782. XX29,
  1783. XX0,
  1784. XX
  1785. XX39,
  1786. XX0,
  1787. XX0};
  1788. XX# define YYTYPE char
  1789. XXstruct yywork { YYTYPE verify, advance; } yycrank[] ={
  1790. XX0,0,    0,0,    1,3,    0,0,    
  1791. XX6,36,    0,0,    7,38,    0,0,    
  1792. XX0,0,    0,0,    0,0,    1,4,    
  1793. XX0,0,    6,36,    0,0,    7,39,    
  1794. XX0,0,    0,0,    0,0,    0,0,    
  1795. XX0,0,    0,0,    0,0,    0,0,    
  1796. XX0,0,    0,0,    0,0,    0,0,    
  1797. XX0,0,    0,0,    0,0,    0,0,    
  1798. XX0,0,    34,56,    1,5,    1,6,    
  1799. XX1,7,    6,37,    63,65,    7,38,    
  1800. XX1,8,    1,9,    1,10,    1,11,    
  1801. XX1,12,    1,13,    1,14,    65,67,    
  1802. XX1,15,    1,16,    26,51,    6,36,    
  1803. XX56,63,    7,38,    63,63,    0,0,    
  1804. XX0,0,    0,0,    8,40,    0,0,    
  1805. XX1,17,    1,18,    1,19,    1,20,    
  1806. XX5,35,    18,47,    1,21,    8,0,    
  1807. XX6,36,    1,22,    7,38,    1,23,    
  1808. XX14,42,    14,42,    14,42,    14,42,    
  1809. XX14,42,    14,42,    14,42,    14,42,    
  1810. XX14,42,    14,42,    20,48,    0,0,    
  1811. XX0,0,    1,24,    14,43,    0,0,    
  1812. XX0,0,    0,0,    0,0,    8,40,    
  1813. XX1,25,    1,26,    1,27,    0,0,    
  1814. XX1,28,    0,0,    1,29,    1,30,    
  1815. XX29,52,    1,31,    22,50,    50,59,    
  1816. XX64,66,    8,40,    31,54,    2,5,    
  1817. XX33,55,    2,34,    55,62,    62,64,    
  1818. XX1,32,    2,8,    2,9,    2,10,    
  1819. XX2,11,    2,12,    2,13,    2,14,    
  1820. XX1,33,    2,15,    8,40,    30,53,    
  1821. XX53,60,    54,61,    0,0,    0,0,    
  1822. XX0,0,    0,0,    0,0,    0,0,    
  1823. XX0,0,    2,17,    2,18,    2,19,    
  1824. XX2,20,    0,0,    0,0,    0,0,    
  1825. XX0,0,    0,0,    2,22,    0,0,    
  1826. XX2,23,    0,0,    0,0,    0,0,    
  1827. XX0,0,    8,41,    0,0,    0,0,    
  1828. XX0,0,    0,0,    0,0,    0,0,    
  1829. XX0,0,    0,0,    2,24,    0,0,    
  1830. XX0,0,    0,0,    0,0,    0,0,    
  1831. XX0,0,    2,25,    2,26,    2,27,    
  1832. XX0,0,    2,28,    0,0,    2,29,    
  1833. XX2,30,    16,44,    2,31,    16,45,    
  1834. XX16,45,    16,45,    16,45,    16,45,    
  1835. XX16,45,    16,45,    16,45,    16,45,    
  1836. XX16,45,    2,32,    0,0,    0,0,    
  1837. XX0,0,    0,0,    0,0,    0,0,    
  1838. XX0,0,    2,33,    21,49,    21,49,    
  1839. XX21,49,    21,49,    21,49,    21,49,    
  1840. XX21,49,    21,49,    21,49,    21,49,    
  1841. XX0,0,    0,0,    0,0,    0,0,    
  1842. XX0,0,    0,0,    0,0,    21,49,    
  1843. XX21,49,    21,49,    21,49,    21,49,    
  1844. XX21,49,    21,49,    21,49,    21,49,    
  1845. XX21,49,    21,49,    21,49,    21,49,    
  1846. XX21,49,    21,49,    21,49,    21,49,    
  1847. XX21,49,    21,49,    21,49,    21,49,    
  1848. XX21,49,    21,49,    21,49,    21,49,    
  1849. XX21,49,    0,0,    0,0,    0,0,    
  1850. XX0,0,    16,46,    0,0,    21,49,    
  1851. XX21,49,    21,49,    21,49,    21,49,    
  1852. XX21,49,    21,49,    21,49,    21,49,    
  1853. XX21,49,    21,49,    21,49,    21,49,    
  1854. XX21,49,    21,49,    21,49,    21,49,    
  1855. XX21,49,    21,49,    21,49,    21,49,    
  1856. XX21,49,    21,49,    21,49,    21,49,    
  1857. XX21,49,    41,57,    0,0,    0,0,    
  1858. XX0,0,    0,0,    0,0,    0,0,    
  1859. XX0,0,    42,58,    41,0,    42,42,    
  1860. XX42,42,    42,42,    42,42,    42,42,    
  1861. XX42,42,    42,42,    42,42,    42,42,    
  1862. XX42,42,    44,44,    44,44,    44,44,    
  1863. XX44,44,    44,44,    44,44,    44,44,    
  1864. XX44,44,    44,44,    44,44,    67,67,    
  1865. XX0,0,    68,67,    41,57,    58,58,    
  1866. XX58,58,    58,58,    58,58,    58,58,    
  1867. XX58,58,    58,58,    58,58,    58,58,    
  1868. XX58,58,    0,0,    0,0,    0,0,    
  1869. XX41,57,    0,0,    0,0,    0,0,    
  1870. XX0,0,    0,0,    0,0,    0,0,    
  1871. XX0,0,    0,0,    0,0,    0,0,    
  1872. XX0,0,    0,0,    0,0,    0,0,    
  1873. XX67,68,    41,57,    68,68,    0,0,    
  1874. XX0,0,    0,0,    0,0,    0,0,    
  1875. XX0,0,    0,0,    0,0,    0,0,    
  1876. XX0,0,    0,0,    67,67,    0,0,    
  1877. XX68,67,    0,0,    0,0,    0,0,    
  1878. XX0,0,    0,0,    0,0,    0,0,    
  1879. XX0,0,    0,0,    0,0,    0,0,    
  1880. XX0,0,    0,0,    0,0,    67,67,    
  1881. XX0,0,    68,67,    0,0,    0,0,    
  1882. XX0,0};
  1883. XXstruct yysvf yysvec[] ={
  1884. XX0,    0,    0,
  1885. XXyycrank+-1,    0,        0,    
  1886. XXyycrank+-74,    yysvec+1,    0,    
  1887. XXyycrank+0,    0,        yyvstop+1,
  1888. XXyycrank+0,    0,        yyvstop+3,
  1889. XXyycrank+3,    0,        yyvstop+5,
  1890. XXyycrank+-3,    0,        yyvstop+7,
  1891. XXyycrank+-5,    0,        yyvstop+9,
  1892. XXyycrank+-57,    0,        yyvstop+11,
  1893. XXyycrank+0,    0,        yyvstop+13,
  1894. XXyycrank+0,    0,        yyvstop+16,
  1895. XXyycrank+0,    0,        yyvstop+19,
  1896. XXyycrank+0,    0,        yyvstop+22,
  1897. XXyycrank+0,    0,        yyvstop+25,
  1898. XXyycrank+24,    0,        yyvstop+28,
  1899. XXyycrank+0,    0,        yyvstop+31,
  1900. XXyycrank+127,    0,        yyvstop+34,
  1901. XXyycrank+0,    0,        yyvstop+37,
  1902. XXyycrank+4,    0,        yyvstop+40,
  1903. XXyycrank+0,    0,        yyvstop+43,
  1904. XXyycrank+21,    0,        yyvstop+46,
  1905. XXyycrank+146,    0,        yyvstop+49,
  1906. XXyycrank+1,    yysvec+21,    yyvstop+52,
  1907. XXyycrank+0,    yysvec+21,    yyvstop+55,
  1908. XXyycrank+0,    yysvec+21,    yyvstop+59,
  1909. XXyycrank+0,    0,        yyvstop+63,
  1910. XXyycrank+3,    0,        yyvstop+66,
  1911. XXyycrank+0,    0,        yyvstop+69,
  1912. XXyycrank+0,    0,        yyvstop+72,
  1913. XXyycrank+3,    yysvec+21,    yyvstop+75,
  1914. XXyycrank+6,    yysvec+21,    yyvstop+78,
  1915. XXyycrank+1,    yysvec+21,    yyvstop+81,
  1916. XXyycrank+0,    yysvec+21,    yyvstop+84,
  1917. XXyycrank+4,    yysvec+21,    yyvstop+88,
  1918. XXyycrank+-1,    yysvec+7,    yyvstop+91,
  1919. XXyycrank+0,    0,        yyvstop+93,
  1920. XXyycrank+0,    yysvec+6,    0,    
  1921. XXyycrank+0,    0,        yyvstop+95,
  1922. XXyycrank+0,    yysvec+7,    0,    
  1923. XXyycrank+0,    0,        yyvstop+97,
  1924. XXyycrank+0,    0,        yyvstop+99,
  1925. XXyycrank+-268,    0,        yyvstop+101,
  1926. XXyycrank+231,    0,        yyvstop+103,
  1927. XXyycrank+0,    0,        yyvstop+105,
  1928. XXyycrank+241,    0,        yyvstop+107,
  1929. XXyycrank+0,    yysvec+16,    yyvstop+109,
  1930. XXyycrank+0,    0,        yyvstop+111,
  1931. XXyycrank+0,    0,        yyvstop+113,
  1932. XXyycrank+0,    0,        yyvstop+115,
  1933. XXyycrank+0,    yysvec+21,    yyvstop+117,
  1934. XXyycrank+1,    yysvec+21,    yyvstop+119,
  1935. XXyycrank+0,    0,        yyvstop+121,
  1936. XXyycrank+0,    yysvec+21,    yyvstop+123,
  1937. XXyycrank+10,    yysvec+21,    yyvstop+126,
  1938. XXyycrank+7,    yysvec+21,    yyvstop+129,
  1939. XXyycrank+5,    yysvec+21,    yyvstop+131,
  1940. XXyycrank+-4,    yysvec+7,    0,    
  1941. XXyycrank+0,    0,        yyvstop+133,
  1942. XXyycrank+255,    0,        yyvstop+135,
  1943. XXyycrank+0,    yysvec+21,    yyvstop+137,
  1944. XXyycrank+0,    yysvec+21,    yyvstop+140,
  1945. XXyycrank+0,    yysvec+21,    yyvstop+143,
  1946. XXyycrank+3,    yysvec+21,    yyvstop+146,
  1947. XXyycrank+-6,    yysvec+7,    0,    
  1948. XXyycrank+3,    yysvec+21,    yyvstop+148,
  1949. XXyycrank+-13,    yysvec+7,    0,    
  1950. XXyycrank+0,    yysvec+21,    yyvstop+150,
  1951. XXyycrank+-298,    yysvec+7,    0,    
  1952. XXyycrank+-300,    yysvec+7,    yyvstop+153,
  1953. XX0,    0,    0};
  1954. XXstruct yywork *yytop = yycrank+365;
  1955. XXstruct yysvf *yybgin = yysvec+1;
  1956. XXchar yymatch[] ={
  1957. XX00  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
  1958. XX01  ,01  ,012 ,01  ,01  ,01  ,01  ,01  ,
  1959. XX01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
  1960. XX01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
  1961. XX01  ,01  ,'"' ,01  ,01  ,01  ,01  ,01  ,
  1962. XX01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
  1963. XX'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,
  1964. XX'0' ,'0' ,01  ,01  ,01  ,01  ,01  ,01  ,
  1965. XX01  ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
  1966. XX'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
  1967. XX'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
  1968. XX'A' ,'A' ,'A' ,01  ,01  ,01  ,01  ,01  ,
  1969. XX01  ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
  1970. XX'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
  1971. XX'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
  1972. XX'A' ,'A' ,'A' ,01  ,01  ,01  ,01  ,01  ,
  1973. XX0};
  1974. XXchar yyextra[] ={
  1975. XX0,0,0,0,0,0,0,0,
  1976. XX0,0,0,0,0,0,0,0,
  1977. XX0,0,0,0,0,0,0,0,
  1978. XX0,0,0,0,0,0,0,0,
  1979. XX0,0,0,0,0,0,0,0,
  1980. XX0,0,0,0,0,0,0,0,
  1981. XX0};
  1982. XX/*    ncform    4.1    83/08/11    */
  1983. XX
  1984. XXint yylineno =1;
  1985. XX# define YYU(x) x
  1986. XX# define NLSTATE yyprevious=YYNEWLINE
  1987. XXchar yytext[YYLMAX];
  1988. XXstruct yysvf *yylstate [YYLMAX], **yylsp, **yyolsp;
  1989. XXchar yysbuf[YYLMAX];
  1990. XXchar *yysptr = yysbuf;
  1991. XXint *yyfnd;
  1992. XXextern struct yysvf *yyestate;
  1993. XXint yyprevious = YYNEWLINE;
  1994. XXyylook(){
  1995. XX    register struct yysvf *yystate, **lsp;
  1996. XX    register struct yywork *yyt;
  1997. XX    struct yysvf *yyz;
  1998. XX    int yych;
  1999. XX    struct yywork *yyr;
  2000. XX# ifdef LEXDEBUG
  2001. XX    int debug;
  2002. XX# endif
  2003. XX    char *yylastch;
  2004. XX    /* start off machines */
  2005. XX# ifdef LEXDEBUG
  2006. XX    debug = 0;
  2007. XX# endif
  2008. XX    if (!yymorfg)
  2009. XX        yylastch = yytext;
  2010. XX    else {
  2011. XX        yymorfg=0;
  2012. XX        yylastch = yytext+yyleng;
  2013. XX        }
  2014. XX    for(;;){
  2015. XX        lsp = yylstate;
  2016. XX        yyestate = yystate = yybgin;
  2017. XX        if (yyprevious==YYNEWLINE) yystate++;
  2018. XX        for (;;){
  2019. XX# ifdef LEXDEBUG
  2020. XX            if(debug)(void) fprintf(yyout,"state %d\n",yystate-yysvec-1);
  2021. XX# endif
  2022. XX            yyt = yystate->yystoff;
  2023. XX            if(yyt == yycrank){        /* may not be any transitions */
  2024. XX                yyz = yystate->yyother;
  2025. XX                if(yyz == 0)break;
  2026. XX                if(yyz->yystoff == yycrank)break;
  2027. XX                }
  2028. XX            *yylastch++ = yych = input();
  2029. XX        tryagain:
  2030. XX# ifdef LEXDEBUG
  2031. XX            if(debug){
  2032. XX                (void) fprintf(yyout,"char ");
  2033. XX                allprint(yych);
  2034. XX                (void) putchar('\n');
  2035. XX                }
  2036. XX# endif
  2037. XX            yyr = yyt;
  2038. XX            if ( (int)yyt > (int)yycrank){
  2039. XX                yyt = yyr + yych;
  2040. XX                if (yyt <= yytop && yyt->verify+yysvec == yystate){
  2041. XX                    if(yyt->advance+yysvec == YYLERR)    /* error transitions */
  2042. XX                        {unput(*--yylastch);break;}
  2043. XX                    *lsp++ = yystate = yyt->advance+yysvec;
  2044. XX                    goto contin;
  2045. XX                    }
  2046. XX                }
  2047. XX# ifdef YYOPTIM
  2048. XX            else if((int)yyt < (int)yycrank) {        /* r < yycrank */
  2049. XX                yyt = yyr = yycrank+(yycrank-yyt);
  2050. XX# ifdef LEXDEBUG
  2051. XX                if(debug)(void) fprintf(yyout,"compressed state\n");
  2052. XX# endif
  2053. XX                yyt = yyt + yych;
  2054. XX                if(yyt <= yytop && yyt->verify+yysvec == yystate){
  2055. XX                    if(yyt->advance+yysvec == YYLERR)    /* error transitions */
  2056. XX                        {unput(*--yylastch);break;}
  2057. XX                    *lsp++ = yystate = yyt->advance+yysvec;
  2058. XX                    goto contin;
  2059. XX                    }
  2060. XX                yyt = yyr + YYU(yymatch[yych]);
  2061. XX# ifdef LEXDEBUG
  2062. XX                if(debug){
  2063. XX                    (void) fprintf(yyout,"try fall back character ");
  2064. XX                    allprint(YYU(yymatch[yych]));
  2065. XX                    (void) putchar('\n');
  2066. XX                    }
  2067. XX# endif
  2068. XX                if(yyt <= yytop && yyt->verify+yysvec == yystate){
  2069. XX                    if(yyt->advance+yysvec == YYLERR)    /* error transition */
  2070. XX                        {unput(*--yylastch);break;}
  2071. XX                    *lsp++ = yystate = yyt->advance+yysvec;
  2072. XX                    goto contin;
  2073. XX                    }
  2074. XX                }
  2075. XX            if ((yystate = yystate->yyother) && (yyt= yystate->yystoff) != yycrank){
  2076. XX# ifdef LEXDEBUG
  2077. XX                if(debug)(void) fprintf(yyout,"fall back to state %d\n",yystate-yysvec-1);
  2078. XX# endif
  2079. XX                goto tryagain;
  2080. XX                }
  2081. XX# endif
  2082. XX            else
  2083. XX                {unput(*--yylastch);break;}
  2084. XX        contin:
  2085. XX# ifdef LEXDEBUG
  2086. XX            if(debug){
  2087. XX                (void) fprintf(yyout,"state %d char ",yystate-yysvec-1);
  2088. XX                allprint(yych);
  2089. XX                (void) putchar('\n');
  2090. XX                }
  2091. XX# endif
  2092. XX            ;
  2093. XX            }
  2094. XX# ifdef LEXDEBUG
  2095. XX        if(debug){
  2096. XX            (void) fprintf(yyout,"stopped at %d with ",*(lsp-1)-yysvec-1);
  2097. XX            allprint(yych);
  2098. XX            (void) putchar('\n');
  2099. XX            }
  2100. XX# endif
  2101. XX        while (lsp-- > yylstate){
  2102. XX            *yylastch-- = 0;
  2103. XX            if (*lsp != 0 && (yyfnd= (*lsp)->yystops) && *yyfnd > 0){
  2104. XX                yyolsp = lsp;
  2105. XX                if(yyextra[*yyfnd]){        /* must backup */
  2106. XX                    while(yyback((*lsp)->yystops,-*yyfnd) != 1 && lsp > yylstate){
  2107. XX                        lsp--;
  2108. XX                        unput(*yylastch--);
  2109. XX                        }
  2110. XX                    }
  2111. XX                yyprevious = YYU(*yylastch);
  2112. XX                yylsp = lsp;
  2113. XX                yyleng = yylastch-yytext+1;
  2114. XX                yytext[yyleng] = 0;
  2115. XX# ifdef LEXDEBUG
  2116. XX                if(debug){
  2117. XX                    (void) fprintf(yyout,"\nmatch ");
  2118. XX                    sprint(yytext);
  2119. XX                    (void) fprintf(yyout," action %d\n",*yyfnd);
  2120. XX                    }
  2121. XX# endif
  2122. XX                return(*yyfnd++);
  2123. XX                }
  2124. XX            unput(*yylastch);
  2125. XX            }
  2126. XX        if (yytext[0] == 0  /* && feof(yyin) */)
  2127. XX            {
  2128. XX            yysptr=yysbuf;
  2129. XX            return(0);
  2130. XX            }
  2131. XX        yyprevious = yytext[0] = input();
  2132. XX        if (yyprevious>0)
  2133. XX            output(yyprevious);
  2134. XX        yylastch=yytext;
  2135. XX# ifdef LEXDEBUG
  2136. XX        if(debug)(void) putchar('\n');
  2137. XX# endif
  2138. XX        }
  2139. XX    }
  2140. XXyyback(p, m)
  2141. XX    int *p;
  2142. XX{
  2143. XXif (p==0) return(0);
  2144. XXwhile (*p)
  2145. XX    {
  2146. XX    if (*p++ == m)
  2147. XX        return(1);
  2148. XX    }
  2149. XXreturn(0);
  2150. XX}
  2151. XX    /* the following are only used in the lex library */
  2152. XXyyinput(){
  2153. XX    return(input());
  2154. XX    }
  2155. XXyyoutput(c)
  2156. XX  int c; {
  2157. XX    output(c);
  2158. XX    }
  2159. XXyyunput(c)
  2160. XX   int c; {
  2161. XX    unput(c);
  2162. XX    }
  2163. SHAR_EOF
  2164. if test 12642 -ne "`wc -c lex.yy.c`"
  2165. then
  2166. echo shar: error transmitting lex.yy.c '(should have been 12642 characters)'
  2167. fi
  2168. #    End of shell archive
  2169. exit 0
  2170.  
  2171. -- 
  2172. Please send comp.sources.unix-related mail to rsalz@uunet.uu.net.
  2173. Use a domain-based address or give alternate paths, or you may lose out.
  2174.